home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0080_TrueName equivalent.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  2KB  |  89 lines
  1.  
  2. { This program uses a proc from my pascal library that I use to get
  3.   true names. Written and tested with tp4  should work with any tp and
  4.   dos 3.1+  gm 05/94 }
  5. uses
  6.   dos;
  7.   {--05/93 gary a. mays --}
  8.   {  this procedure uses the undocumented dos function $60 to fetch the
  9.      canonical name of a file or path specification }
  10.   procedure canonicalize(path: string; var canonical: string;
  11.                           var stat: word);
  12.     var
  13.       regs : registers;
  14.       i : integer;
  15.       bytes : byte absolute canonical;
  16.   begin
  17.     with regs do
  18.     begin
  19.       stat := 0;
  20.       ah := $60;
  21.       path := path + chr(0); { convert to asciz }
  22.       ds := seg(path[1]); { asciz name }
  23.       si := ofs(path[1]);
  24.       es := seg(canonical[1]);{ points to 128 byte result buffer }
  25.       di := ofs(canonical[1]);{ result is asciz }
  26.       msdos(regs); { returns canonical name: does not have to exist... }
  27.       if flags and fcarry > 0 then
  28.         stat := ax
  29.       else
  30.       begin
  31.         bytes := 0;
  32.         while canonical[bytes + 1] <> #0 do inc(bytes); {conv to ascii}
  33.         { not tested on a network - this test will fail on net drive }
  34.         if canonical[2] <> ':' then { bad because of bad path }
  35.           stat := 3;
  36.       end;
  37.     end;
  38.   end; {canonicalize}
  39.  
  40.   var
  41.     stat : word;
  42.     path : string;
  43.     canonical : string;
  44. begin
  45.   if paramstr(1) = '' then
  46.     path := '.'
  47.   else
  48.     path := paramstr(1);
  49.   canonicalize(path, canonical, stat);
  50.   case stat of
  51.   0: writeln(canonical);
  52.   2: writeln('Invalid path: ',path);
  53.   3: writeln('Invalid drive or malformed path: ',path);
  54.   else writeln('Status: ',stat,' for ',path);
  55.   end; {case}
  56. end.
  57.  
  58.  
  59. IL>  I'm looking for an equivalent to the DOS command TRUENAME. Here's an
  60.  
  61. program TruePath;
  62. uses OpString,DOS;
  63. var
  64.   OldName, NewName : String;
  65.   RegisterSet : Registers;
  66. Begin
  67.   OldName:=ParamStr(1);
  68.   OldName[Length(OldName)+1] := #0;
  69.   NewName[0] := #0;
  70.   With RegisterSet do
  71.   Begin
  72.     AH := $60;
  73.     AL := 0;
  74.     DS := Seg(OldName[1]);
  75.     SI := Ofs(OldName[1]);
  76.     ES := Seg(NewName[1]);
  77.     DI := Ofs(NewName[1]);
  78.   End;
  79.   MsDos(RegisterSet);
  80.   If Odd(RegisterSet.Flags) Then
  81.     Writeln('Failure ',RegisterSet.AX) (* failure code *)
  82.   Else
  83.   Begin
  84.     NewName[0]:=#255;
  85.     NewName[0]:=Chr(Pos(#0,NewName));
  86.     Writeln(NewName);
  87.   End;
  88. End.
  89.